home *** CD-ROM | disk | FTP | other *** search
/ The World of Computer Software / The World of Computer Software.iso / srcuc.zip / MEMMAG.C < prev    next >
C/C++ Source or Header  |  1992-01-14  |  13KB  |  458 lines
  1. /* -*-C-*-
  2.  
  3. $Header: /scheme/src/microcode/RCS/memmag.c,v 9.47 1992/01/15 03:35:48 jinx Exp $
  4.  
  5. Copyright (c) 1987-92 Massachusetts Institute of Technology
  6.  
  7. This material was developed by the Scheme project at the Massachusetts
  8. Institute of Technology, Department of Electrical Engineering and
  9. Computer Science.  Permission to copy this software, to redistribute
  10. it, and to use it for any purpose is granted, subject to the following
  11. restrictions and understandings.
  12.  
  13. 1. Any copy made of this software must include this copyright notice
  14. in full.
  15.  
  16. 2. Users of this software agree to make their best efforts (a) to
  17. return to the MIT Scheme project any improvements or extensions that
  18. they make, so that these may be included in future releases; and (b)
  19. to inform MIT of noteworthy uses of this software.
  20.  
  21. 3. All materials developed as a consequence of the use of this
  22. software shall duly acknowledge such use, in accordance with the usual
  23. standards of acknowledging credit in academic research.
  24.  
  25. 4. MIT has made no warrantee or representation that the operation of
  26. this software will be error-free, and MIT is under no obligation to
  27. provide any services, by way of maintenance, update, or otherwise.
  28.  
  29. 5. In conjunction with products arising from the use of this material,
  30. there shall be no use of the name of the Massachusetts Institute of
  31. Technology nor of any adaptation thereof in any advertising,
  32. promotional, or sales literature without prior written consent from
  33. MIT in each case. */
  34.  
  35. /* Memory management top level.
  36.  
  37.    The memory management code is spread over 3 files:
  38.    - memmag.c: initialization.
  39.    - gcloop.c: main garbage collector loop.
  40.    - purify.c: constant/pure space hacking.
  41.    There is also a relevant header file, gccode.h.
  42.  
  43.    The object dumper, fasdump, shares properties and code with the
  44.    memory management utilities.
  45.  */
  46.  
  47. #include "scheme.h"
  48. #include "prims.h"
  49. #include "gccode.h"
  50.  
  51. /* Imports */
  52.  
  53. extern SCHEME_OBJECT *
  54.   EXFUN (GCLoop, (SCHEME_OBJECT *, SCHEME_OBJECT **));
  55.  
  56. /* Exports */
  57.  
  58. extern void
  59.   EXFUN (GCFlip, (void)),
  60.   EXFUN (GC, (void));
  61.  
  62. extern void
  63.   EXFUN (Clear_Memory, (int, int, int)),
  64.   EXFUN (Setup_Memory, (int, int, int)),
  65.   EXFUN (Reset_Memory, (void));
  66.  
  67. /*     Memory Allocation, sequential processor:
  68.  
  69.    ------------------------------------------
  70.    |         Control Stack        ||        |
  71.    |                              \/        |
  72.    ------------------------------------------
  73.    |     Constant + Pure Space    /\        |
  74.    |                              ||        |
  75.    ------------------------------------------
  76.    |                                        |
  77.    |           Heap Space                   |
  78.    ------------------------------------------
  79.  
  80.    Each area has a pointer to its starting address and a pointer to the
  81.    next free cell.  In addition, there is a pointer to the top of the
  82.    useable area of the heap (the heap is subdivided into two areas for
  83.    the purposes of GC, and this pointer indicates the top of the half
  84.    currently in use).
  85.  
  86. */
  87.  
  88. /* Initialize free pointers within areas. Stack_Pointer is
  89.    special: it always points to a cell which is in use. */
  90.  
  91. void
  92. DEFUN (Clear_Memory,
  93.        (Our_Heap_Size, Our_Stack_Size, Our_Constant_Size),
  94.        int Our_Heap_Size AND int Our_Stack_Size AND int Our_Constant_Size)
  95. {
  96.   GC_Reserve = 4500;
  97.   GC_Space_Needed = 0;
  98.   Heap_Top = (Heap_Bottom + Our_Heap_Size);
  99.   Local_Heap_Base = Heap_Bottom;
  100.   Unused_Heap_Top = (Heap_Bottom + (2 * Our_Heap_Size));
  101.   SET_MEMTOP (Heap_Top - GC_Reserve);
  102.   Free = Heap_Bottom;
  103.   Constant_Top = (Constant_Space + Our_Constant_Size);
  104.   Initialize_Stack ();
  105.   Free_Constant = Constant_Space;
  106.   SET_CONSTANT_TOP ();
  107.   return;
  108. }
  109.  
  110. /* This procedure allocates and divides the total memory. */
  111.  
  112. void
  113. DEFUN (Setup_Memory,
  114.        (Our_Heap_Size, Our_Stack_Size, Our_Constant_Size),
  115.        int Our_Heap_Size AND int Our_Stack_Size AND int Our_Constant_Size)
  116. {
  117.   SCHEME_OBJECT test_value;
  118.  
  119.   /* Consistency check 1 */
  120.   if (Our_Heap_Size == 0)
  121.   {
  122.     fprintf (stderr, "Configuration won't hold initial data.\n");
  123.     exit (1);
  124.   }
  125.  
  126.   /* Allocate */
  127.   Highest_Allocated_Address =
  128.     ALLOCATE_HEAP_SPACE (Stack_Allocation_Size(Our_Stack_Size) +
  129.              (2 * Our_Heap_Size) +
  130.              Our_Constant_Size +
  131.              HEAP_BUFFER_SPACE);
  132.  
  133.   /* Consistency check 2 */
  134.   if (Heap == NULL)
  135.   {
  136.     fprintf (stderr, "Not enough memory for this configuration.\n");
  137.     exit (1);
  138.   }
  139.  
  140.   /* Initialize the various global parameters */
  141.   Heap += HEAP_BUFFER_SPACE;
  142.   INITIAL_ALIGN_FLOAT (Heap);
  143.   Unused_Heap = (Heap + Our_Heap_Size);
  144.   ALIGN_FLOAT (Unused_Heap);
  145.   Constant_Space = (Heap + (2 * Our_Heap_Size));
  146.   ALIGN_FLOAT (Constant_Space);
  147.  
  148.   /* Consistency check 3 */
  149.  
  150.   test_value = (MAKE_POINTER_OBJECT (LAST_TYPE_CODE, Highest_Allocated_Address));
  151.  
  152.   if (((OBJECT_TYPE (test_value)) != LAST_TYPE_CODE) ||
  153.       ((OBJECT_ADDRESS (test_value)) != Highest_Allocated_Address))
  154.   {
  155.     fprintf (stderr,
  156.          "Largest address does not fit in datum field of object.\n");
  157.     fprintf (stderr,
  158.          "Allocate less space or re-configure without HEAP_IN_LOW_MEMORY.\n");
  159.     exit (1);
  160.   }
  161.  
  162.   Heap_Bottom = Heap;
  163.   Clear_Memory (Our_Heap_Size, Our_Stack_Size, Our_Constant_Size);
  164.   return;
  165. }
  166.  
  167. /* In this version, this does nothing. */
  168.  
  169. void
  170. DEFUN_VOID (Reset_Memory)
  171. {
  172.   return;
  173. }
  174.  
  175. /* Utilities for the garbage collector top level.
  176.    The main garbage collector loop is in gcloop.c
  177. */
  178.  
  179. /* Flip into unused heap */
  180.  
  181. void
  182. DEFUN_VOID (GCFlip)
  183. {
  184.   SCHEME_OBJECT *Temp;
  185.  
  186.   Temp = Unused_Heap;
  187.   Unused_Heap = Heap_Bottom;
  188.   Heap_Bottom = Temp;
  189.   Temp = Unused_Heap_Top;
  190.   Unused_Heap_Top = Heap_Top;
  191.   Heap_Top = Temp;
  192.   Free = Heap_Bottom;
  193.   SET_MEMTOP(Heap_Top - GC_Reserve);
  194.   Weak_Chain = EMPTY_LIST;
  195.   return;
  196. }
  197.  
  198. /* Here is the code which "prunes" objects from weak cons cells.  See
  199.    the picture in gccode.h for a description of the structure built by
  200.    the GC.  This code follows the chain of weak cells (in old space) and
  201.    either updates the new copy's CAR with the relocated version of the
  202.    object, or replaces it with SHARP_F.
  203.  
  204.    Note that this is the only code in the system, besides the inner garbage
  205.    collector, which looks at both old and new space.
  206. */
  207.  
  208. SCHEME_OBJECT Weak_Chain;
  209.  
  210. void
  211. DEFUN_VOID (Fix_Weak_Chain)
  212. {
  213.   fast SCHEME_OBJECT *Old_Weak_Cell, *Scan, Old_Car, Temp, *Old, *Low_Constant;
  214.  
  215.   Low_Constant = Constant_Space;
  216.   while (Weak_Chain != EMPTY_LIST)
  217.   {
  218.     Old_Weak_Cell = OBJECT_ADDRESS (Weak_Chain);
  219.     Scan = OBJECT_ADDRESS (*Old_Weak_Cell++);
  220.     Weak_Chain = *Old_Weak_Cell;
  221.     Old_Car = *Scan;
  222.     Temp = (MAKE_OBJECT_FROM_OBJECTS (Weak_Chain, Old_Car));
  223.     Weak_Chain = (OBJECT_NEW_TYPE (TC_NULL, Weak_Chain));
  224.  
  225.     switch(GC_Type(Temp))
  226.     { case GC_Non_Pointer:
  227.         *Scan = Temp;
  228.     continue;
  229.  
  230.       case GC_Special:
  231.     if (OBJECT_TYPE (Temp) != TC_REFERENCE_TRAP)
  232.     {
  233.       /* No other special type makes sense here. */
  234.       goto fail;
  235.     }
  236.     if (OBJECT_DATUM (Temp) <= TRAP_MAX_IMMEDIATE)
  237.     {
  238.       *Scan = Temp;
  239.       continue;
  240.     }
  241.     /* Otherwise, it is a pointer.  Fall through */
  242.  
  243.       /* Normal pointer types, the broken heart is in the first word.
  244.          Note that most special types are treated normally here.
  245.      The BH code updates *Scan if the object has been relocated.
  246.      Otherwise it falls through and we replace it with a full SHARP_F.
  247.      Eliminating this assignment would keep old data (pl. of datum).
  248.        */
  249.       case GC_Cell:
  250.       case GC_Pair:
  251.       case GC_Triple:
  252.       case GC_Quadruple:
  253.       case GC_Vector:
  254.     Old = OBJECT_ADDRESS (Old_Car);
  255.     if (Old >= Low_Constant)
  256.     {
  257.       *Scan = Temp;
  258.       continue;
  259.     }
  260.     Normal_BH(false, continue);
  261.     *Scan = SHARP_F;
  262.     continue;
  263.  
  264.       case GC_Compiled:
  265.     Old = OBJECT_ADDRESS (Old_Car);
  266.     if (Old >= Low_Constant)
  267.     {
  268.       *Scan = Temp;
  269.       continue;
  270.     }
  271.     Compiled_BH(false, { *Scan = Temp; continue; });
  272.     *Scan = SHARP_F;
  273.     continue;
  274.  
  275.       case GC_Undefined:
  276.     fprintf(stderr,
  277.         "\nFix_Weak_Chain: Clearing bad object 0x%08lx.\n",
  278.         Temp);
  279.     *Scan = SHARP_F;
  280.     continue;
  281.  
  282.       default:            /* Non Marked Headers and Broken Hearts */
  283.       fail:
  284.         fprintf(stderr,
  285.         "\nFix_Weak_Chain: Bad Object: 0x%08lx.\n",
  286.         Temp);
  287.     Microcode_Termination(TERM_INVALID_TYPE_CODE);
  288.     /*NOTREACHED*/
  289.     }
  290.   }
  291.   return;
  292. }
  293.  
  294. /* Here is the set up for the full garbage collection:
  295.  
  296.    - First it makes the constant space and stack into one large area
  297.    by "hiding" the gap between them with a non-marked header.
  298.  
  299.    - Then it saves away all the relevant microcode registers into new
  300.    space, making this the root for garbage collection.
  301.  
  302.    - Then it does the actual garbage collection in 4 steps:
  303.      1) Trace constant space.
  304.      2) Trace objects pointed out by the root and constant space.
  305.      3) Trace the precious objects, remembering where consing started.
  306.      4) Update all weak pointers.
  307.  
  308.    - Finally it restores the microcode registers from the copies in
  309.    new space.
  310. */
  311.  
  312. void 
  313. DEFUN_VOID (GC)
  314. {
  315.   SCHEME_OBJECT
  316.     *Root, *Result, *Check_Value,
  317.     The_Precious_Objects, *Root2;
  318.  
  319.   /* Save the microcode registers so that they can be relocated */
  320.  
  321.   Terminate_Old_Stacklet ();
  322.   SEAL_CONSTANT_SPACE ();
  323.   Check_Value = (CONSTANT_SPACE_SEAL ());
  324.   Root = Free;
  325.   The_Precious_Objects = (Get_Fixed_Obj_Slot (Precious_Objects));
  326.   Set_Fixed_Obj_Slot (Precious_Objects, SHARP_F);
  327.   Set_Fixed_Obj_Slot (Lost_Objects_Base, SHARP_F);
  328.  
  329.   *Free++ = Fixed_Objects;
  330.   *Free++ = (MAKE_POINTER_OBJECT (UNMARKED_HISTORY_TYPE, History));
  331.   *Free++ = Undefined_Primitives;
  332.   *Free++ = Undefined_Primitives_Arity;
  333.   *Free++ = Get_Current_Stacklet ();
  334.   *Free++ =
  335.     ((Prev_Restore_History_Stacklet == NULL)
  336.      ? SHARP_F
  337.      : (MAKE_POINTER_OBJECT (TC_CONTROL_POINT, Prev_Restore_History_Stacklet)));
  338.   *Free++ = Current_State_Point;
  339.   *Free++ = Fluid_Bindings;
  340.  
  341.   /* The 4 step GC */
  342.  
  343.   Result = (GCLoop (Constant_Space, &Free));
  344.   if (Result != Check_Value)
  345.   {
  346.     fprintf (stderr, "\nGC: Constant Scan ended too early.\n");
  347.     Microcode_Termination (TERM_BROKEN_HEART);
  348.   }
  349.  
  350.   Result = (GCLoop (Root, &Free));
  351.   if (Free != Result)
  352.   {
  353.     fprintf (stderr, "\nGC-1: Heap Scan ended too early.\n");
  354.     Microcode_Termination (TERM_BROKEN_HEART);
  355.   }
  356.  
  357.   Root2 = Free;
  358.   *Free++ = The_Precious_Objects;
  359.   Result = (GCLoop (Root2, &Free));
  360.   if (Free != Result)
  361.   {
  362.     fprintf (stderr, "\nGC-2: Heap Scan ended too early.\n");
  363.     Microcode_Termination (TERM_BROKEN_HEART);
  364.   }
  365.  
  366.   Fix_Weak_Chain ();
  367.  
  368.   /* Make the microcode registers point to the copies in new-space. */
  369.  
  370.   Fixed_Objects = *Root++;
  371.   Set_Fixed_Obj_Slot (Precious_Objects, *Root2);
  372.   Set_Fixed_Obj_Slot
  373.     (Lost_Objects_Base, (LONG_TO_UNSIGNED_FIXNUM (ADDRESS_TO_DATUM (Root2))));
  374.  
  375.   History = (OBJECT_ADDRESS (*Root++));
  376.   Undefined_Primitives = *Root++;
  377.   Undefined_Primitives_Arity = *Root++;
  378.  
  379.   Set_Current_Stacklet (*Root);
  380.   Root += 1;
  381.   if (*Root == SHARP_F)
  382.   {
  383.     Prev_Restore_History_Stacklet = NULL;
  384.     Root += 1;
  385.   }
  386.   else
  387.   {
  388.     Prev_Restore_History_Stacklet = (OBJECT_ADDRESS (*Root++));
  389.   }
  390.   Current_State_Point = *Root++;
  391.   Fluid_Bindings = *Root++;
  392.   Free_Stacklets = NULL;
  393.   COMPILER_TRANSPORT_END ();
  394.   CLEAR_INTERRUPT (INT_GC);
  395.   return;
  396. }
  397.  
  398. /* (GARBAGE-COLLECT SLACK)
  399.    Requests a garbage collection leaving the specified amount of slack
  400.    for the top of heap check on the next GC.  The primitive ends by invoking
  401.    the GC daemon if there is one.
  402.  
  403.    This primitive never returns normally.  It always escapes into
  404.    the interpreter because some of its cached registers (eg. History)
  405.    have changed.
  406. */
  407.  
  408. DEFINE_PRIMITIVE ("GARBAGE-COLLECT", Prim_garbage_collect, 1, 1, 0)
  409. {
  410.   long new_gc_reserve;
  411.   extern unsigned long gc_counter;
  412.   SCHEME_OBJECT GC_Daemon_Proc;
  413.   PRIMITIVE_HEADER (1);
  414.   PRIMITIVE_CANONICALIZE_CONTEXT ();
  415.  
  416.   STACK_SANITY_CHECK ("GC");
  417.   new_gc_reserve = (arg_nonnegative_integer (1));
  418.   if (Free > Heap_Top)
  419.   {
  420.     fprintf (stderr,
  421.          "\nGARBAGE-COLLECT: GC has been delayed too long!\n");
  422.     fprintf (stderr,
  423.          "Free = 0x%lx; MemTop = 0x%lx; Heap_Top = 0x%lx\n",
  424.          Free, MemTop, Heap_Top);
  425.     Microcode_Termination (TERM_NO_SPACE);
  426.   }
  427.  
  428.   ENTER_CRITICAL_SECTION ("garbage collector");
  429.   gc_counter += 1;
  430.   GC_Reserve = new_gc_reserve;
  431.   GCFlip ();
  432.   GC ();
  433.   POP_PRIMITIVE_FRAME (1);
  434.   GC_Daemon_Proc = (Get_Fixed_Obj_Slot (GC_Daemon));
  435.  
  436.   RENAME_CRITICAL_SECTION ("garbage collector daemon");
  437.   if (GC_Daemon_Proc == SHARP_F)
  438.   {
  439.    Will_Push (CONTINUATION_SIZE);
  440.     Store_Return (RC_NORMAL_GC_DONE);
  441.     Store_Expression (LONG_TO_UNSIGNED_FIXNUM (MemTop - Free));
  442.     Save_Cont ();
  443.    Pushed ();
  444.     PRIMITIVE_ABORT (PRIM_POP_RETURN);
  445.     /*NOTREACHED*/
  446.   }
  447.  Will_Push (CONTINUATION_SIZE + (STACK_ENV_EXTRA_SLOTS + 1));
  448.   Store_Return (RC_NORMAL_GC_DONE);
  449.   Store_Expression (LONG_TO_UNSIGNED_FIXNUM(MemTop - Free));
  450.   Save_Cont ();
  451.   STACK_PUSH (GC_Daemon_Proc);
  452.   STACK_PUSH (STACK_FRAME_HEADER);
  453.  Pushed ();
  454.   PRIMITIVE_ABORT (PRIM_APPLY);
  455.   /* The following comment is by courtesy of LINT, your friendly sponsor. */
  456.   /*NOTREACHED*/
  457. }
  458.